home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lib / progman.pl < prev    next >
Encoding:
Text File  |  1997-04-04  |  6.2 KB  |  242 lines
  1. /*  $Id: progman.pl,v 1.10 1997/04/04 09:05:42 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: Simple program consistency check predicates
  7. */
  8.  
  9. :- module(progman,
  10.       [ progman_groups/1,        % -ListOfExistingGroups
  11.         progman_group_info/3,    % +Group, -File, -Items
  12.  
  13.         progman_make_group/1,    % +Group
  14.         progman_make_group/2,    % +Group, +GroupFile
  15.         progman_make_item/4,    % +Group, +Title, +CmdLine, +Cwd
  16.         progman_make_item/5,    % +Group, +Title, +CmdLine, +Cwd, +Icon
  17.  
  18.         progman_setup/0        % Installs icons
  19.       ]).
  20.  
  21. :- (   feature(dde, true)
  22.    ->  true
  23.    ;   '$warning'('Module "library(progman)" requires DDE support')
  24.    ).
  25.  
  26. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  27. MS-Windows  PROGMAN  interface  and  installation   for  SWI-Prolog  and
  28. XPCE/SWI-Prolog.
  29. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  30.  
  31. %    progman_groups(-Groups)
  32. %
  33. %    Return list of atoms containing the titles of the currently
  34. %    available program groups.
  35.  
  36. progman_groups(Groups) :-
  37.     open_dde_conversation(progman, progman, DDE),
  38.     dde_request(DDE, groups, Lines),
  39.     lines_to_atoms(Lines, Groups0),
  40.     close_dde_conversation(DDE),
  41.     Groups = Groups0.
  42.  
  43. %    progman_group_info(+Group, -File, -Items)
  44. %
  45. %    Extracts info on the given group: Filename used to store the
  46. %    group and a list of item(Title, CmdLine, Dir) terms.
  47.  
  48. progman_group_info(Group, File, Items) :-
  49.     open_dde_conversation(progman, progman, DDE),
  50.     dde_request(DDE, Group, Info),
  51.     close_dde_conversation(DDE),
  52.     lines_to_atoms(Info, [GrounInfo|ItemLines]),
  53.     line_to_args(GrounInfo, [_,File|_]),
  54.     maplist(map_item_info, ItemLines, Items).
  55.  
  56. %    progman_make_group(+Name, [+File])
  57. %
  58. %    Create a group in the program manager.  If file is given, this
  59. %    is the file used by Windows to store the group info.
  60.  
  61. progman_make_group(Name) :-
  62.     open_dde_conversation(progman, progman, DDE),
  63.     dde_fmt_execute(DDE, '[CreateGroup("~w")]', [Name]),
  64.     close_dde_conversation(DDE).
  65. progman_make_group(Name, File) :-
  66.     open_dde_conversation(progman, progman, DDE),
  67.     dde_fmt_execute(DDE, '[CreateGroup("~w", "~w")]', [Name, File]),
  68.     close_dde_conversation(DDE).
  69.  
  70. %    progman_make_item(+Group, +Title, +CmdLine, +Dir)
  71. %    
  72. %    Make a new program item in the named group.  If the item already
  73. %    exists, delete it.
  74.  
  75. progman_make_item(Group, Title, CmdLine, Dir) :-
  76.     progman_make_item(Group, Title, CmdLine, Dir, -).
  77. progman_make_item(Group, Title, CmdLine, Dir, Icon) :-
  78.     (   nonvar(Icon),
  79.         Icon = IconFile:IconNum
  80.     ->  true
  81.     ;   IconFile = '',
  82.         IconFile = ''
  83.     ),
  84.     progman_group_info(Group, _File, Items),
  85.     open_dde_conversation(progman, progman, DDE),
  86.     dde_fmt_execute(DDE, '[ShowGroup("~w", 1)]', Group),
  87.     (   memberchk(item(Title, _, _), Items)
  88.     ->  dde_fmt_execute(DDE, '[ReplaceItem("~w")]', [Title])
  89.     ;   true
  90.     ),
  91.     dde_fmt_execute(DDE, '[addItem(~w, "~w",~w,~w,,, "~w",,)]',
  92.             [CmdLine, Title, IconFile, IconNum, Dir]),
  93.     dde_fmt_execute(DDE, '[ShowGroup("~w", 0)]', Group),
  94.     close_dde_conversation(DDE).
  95.  
  96. %    program_group(+Default, -Group)
  97. %
  98. %    Given a default group name, ask for a new name if this group
  99. %    already exists.
  100.  
  101. program_group(Default, Group) :-
  102.     progman_groups(Existing),
  103.     memberchk(Default, Existing), !,
  104.     (   '$confirm'('Put (replace) items in existing group ~w', [Default])
  105.     ->  Group = Default
  106.     ;   format('Enter new group name: '),
  107.         read_line(NewDef),
  108.         program_group(NewDef, Group)
  109.     ).
  110. program_group(Default, Default).
  111.  
  112.          /*******************************
  113.          *           INSTALL        *
  114.          *******************************/
  115.  
  116. progman_setup :-
  117.     explain(start),
  118.  
  119.     program_group('SWI-Prolog', Group),
  120.     feature(symbol_file, PlExe),
  121.     prolog_to_os_filename(PlExe, OsPlExe),
  122.  
  123.     progman_make_group(Group),
  124.     progman_make_item(Group, 'SWI-Prolog', OsPlExe, 'c:'),
  125.     explain(end).
  126.  
  127.  
  128.          /*******************************
  129.          *          EXPLAIN        *
  130.          *******************************/
  131.  
  132. explanation(start, '').
  133. explanation(start, '*******************************************************').
  134. explanation(start, 'SWI-Prolog installation run').
  135. explanation(start, '*******************************************************').
  136. explanation(start, '').
  137.  
  138. explanation(end, '').
  139. explanation(end, 'Program manager setup completed').
  140. explanation(end, '').
  141.  
  142. explain(Id) :-
  143.     explanation(Id, X),
  144.     format('~w~n', [X]),
  145.     fail ; true.
  146.  
  147. %    line_to_args(+Line, -Args)
  148. %
  149. %    Translate a line (Atom) as returned by PROGMAN's request for
  150. %    the contents of a group into a list of atomic arguments.  Arguments
  151. %    are separated by `,', may be double-quoted and don't contain
  152. %    blank space.
  153.  
  154. line_to_args(Line, Args) :-
  155.     name(Line, Str),
  156.     phrase(line(Args), Str).
  157.  
  158. map_item_info(Line, item(Title, CmdLine, Dir)) :-
  159.     line_to_args(Line, [Title, CmdLine, Dir|_]).
  160.  
  161. line([Arg|More]) -->
  162.     string(Arg), !,
  163.     line(More).
  164. line(Args) -->
  165.     char(","), !,
  166.     line(Args).
  167. line([Arg|More]) -->
  168.     char([C]),
  169.     string_val(A0),
  170.     (   char(",")
  171.     ;   end_of_string
  172.     ), !,
  173.     { name(Arg, [C|A0]) },
  174.     line(More).
  175. line([]) -->
  176.     [].
  177.     
  178. string(Arg) -->
  179.     char(""""), !,
  180.     string_val(A0),
  181.     char(""""), !,
  182.     { name(Arg, A0) }.
  183.  
  184. string_val([]) -->
  185.     [].
  186. string_val([C|M]) -->
  187.     char([C]),
  188.     string_val(M).
  189.  
  190. char([C], [C|T], T).
  191. end_of_string([], []).
  192.  
  193. %    lines_to_atoms(+Lines, -Atoms)
  194. %       
  195. %    Break a multiline answer from PROGMAN in multiple atoms, each
  196. %    describing a single line of the answer without the \r\n.
  197.  
  198. lines_to_atoms(Lines, Atoms) :-
  199.     name(Lines, Str),
  200.     string_to_atoms(Str, [], Atoms).
  201.  
  202. string_to_atoms([], [], []) :- !.
  203. string_to_atoms([], S0,  [A]) :- !,
  204.     reverse(S0, S),
  205.     name(A, S).
  206. string_to_atoms([13,10|Rest], S0, [A|T]) :- !,
  207.     reverse(S0, S),
  208.     name(A, S),
  209.     string_to_atoms(Rest, [], T).
  210. string_to_atoms([10|Rest], S0, [A|T]) :- !,
  211.     reverse(S0, S),
  212.     name(A, S),
  213.     string_to_atoms(Rest, [], T).
  214. string_to_atoms([C|T], M, A) :-
  215.     string_to_atoms(T, [C|M], A).
  216.  
  217. %    read_line(-Line)
  218. %
  219. %    Flush pending output and read input upto a newline.  Return the
  220. %    entered line as an atom.
  221.  
  222. read_line(Line) :-
  223.     flush,
  224.     prompt(O, ''),
  225.     read_chars(Chars),
  226.     prompt(_, O),
  227.     name(Line, Chars).
  228.  
  229. read_chars([C|T]) :-
  230.     get0(C),
  231.     \+ memberchk(C, [10,13,4]),
  232.     read_chars(T).
  233. read_chars([]).
  234.  
  235. %    dde_fmt_execute(+DdeId, +Format, +Args)
  236. %
  237. %    Utility predicate to create DDE commands from a formatted spec.
  238.  
  239. dde_fmt_execute(DDE, Fmt, Args) :-
  240.     sformat(Cmd, Fmt, Args),
  241.     dde_execute(DDE, Cmd).
  242.